home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / perly.y < prev    next >
Text File  |  1993-10-23  |  24KB  |  896 lines
  1. /* $RCSfile: perly.y,v $$Revision: 4.0.1.6 $$Date: 1993/02/05 19:41:15 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    perly.y,v $
  9.  * Revision 4.0.1.5  1992/06/11  21:12:50  lwall
  10.  * patch34: expectterm incorrectly set to indicate start of program or block
  11.  * 
  12.  * Revision 4.0.1.4  92/06/08  17:33:25  lwall
  13.  * patch20: one of the backdoors to expectterm was on the wrong reduction
  14.  * 
  15.  * Revision 4.0.1.3  92/06/08  15:18:16  lwall
  16.  * patch20: an expression may now start with a bareword
  17.  * patch20: relaxed requirement for semicolon at the end of a block
  18.  * patch20: added ... as variant on ..
  19.  * patch20: fixed double debug break in foreach with implicit array assignment
  20.  * patch20: if {block} {block} didn't work any more
  21.  * patch20: deleted some minor memory leaks
  22.  * 
  23.  * Revision 4.0.1.2  91/11/05  18:17:38  lwall
  24.  * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!)
  25.  * patch11: once-thru blocks didn't display right in the debugger
  26.  * patch11: debugger got confused over nested subroutine definitions
  27.  * 
  28.  * Revision 4.0.1.1  91/06/07  11:42:34  lwall
  29.  * patch4: new copyright notice
  30.  * 
  31.  * Revision 4.0  91/03/20  01:38:40  lwall
  32.  * 4.0 baseline.
  33.  * 
  34.  */
  35.  
  36. %{
  37. #include "INTERN.h"
  38. #include "perl.h"
  39.  
  40. /*SUPPRESS 530*/
  41. /*SUPPRESS 593*/
  42. /*SUPPRESS 595*/
  43.  
  44. STAB *scrstab;
  45. ARG *arg4;    /* rarely used arguments to make_op() */
  46. ARG *arg5;
  47. ARG *arg6;
  48. %}
  49.  
  50. %start prog
  51.  
  52. %union {
  53.     int    ival;
  54.     char *cval;
  55.     ARG *arg;
  56.     CMD *cmdval;
  57.     struct compcmd compval;
  58.     STAB *stabval;
  59.     FCMD *formval;
  60. }
  61.  
  62. %token <ival> '{' ')'
  63.  
  64. %token <cval> WORD LABEL
  65. %token <ival> APPEND OPEN SSELECT LOOPEX DOTDOT
  66. %token <ival> USING FORMAT DO SHIFT PUSH POP LVALFUN CHOOSE FMIN1 FUNC12
  67. %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE SPLIT FLIST
  68. %token <ival> FOR FILOP FILOP2 FILOP3 FILOP4 FILOP22 FILOP25
  69. %token <ival> FUNC0 FUNC1 FUNC2 FUNC2x FUNC3 FUNC4 FUNC5 HSHFUN HSHFUN3
  70. %token <ival> FLIST2 SUB FILETEST LOCAL DELETE
  71. %token <ival> RELOP EQOP MULOP ADDOP PACKAGE AMPER
  72. %token <formval> FORMLIST
  73. %token <stabval> REG ARYLEN ARY HSH STAR
  74. %token <arg> SUBST PATTERN
  75. %token <arg> RSTRING TRANS
  76.  
  77. %type <ival> prog decl format remember crp
  78. %type <cmdval> block lineseq line loop cond sideff nexpr else
  79. %type <arg> expr sexpr cexpr csexpr term handle aryword hshword
  80. %type <arg> texpr listop bareword
  81. %type <cval> label
  82. %type <compval> compblock
  83.  
  84. %nonassoc <ival> LISTOP
  85. %left ','
  86. %right '='
  87. %right '?' ':'
  88. %nonassoc DOTDOT
  89. %left OROR
  90. %left ANDAND
  91. %left '|' '^'
  92. %left '&'
  93. %nonassoc EQOP
  94. %nonassoc RELOP
  95. %nonassoc <ival> UNIOP
  96. %nonassoc FILETEST
  97. %left LS RS
  98. %left ADDOP
  99. %left MULOP
  100. %left MATCH NMATCH 
  101. %right '!' '~' UMINUS
  102. %right POW
  103. %nonassoc INC DEC
  104. %left '('
  105.  
  106. %% /* RULES */
  107.  
  108. prog    :    /* NULL */
  109.         {
  110. #if defined(YYDEBUG) && defined(DEBUGGING)
  111.             yydebug = (debug & 1);
  112. #endif
  113.             expectterm = 2;
  114.         }
  115.     /*CONTINUED*/    lineseq
  116.             { if (in_eval)
  117.                 eval_root = block_head($2);
  118.                 else
  119.                 main_root = block_head($2); }
  120.     ;
  121.  
  122. compblock:    block CONTINUE block
  123.             { $$.comp_true = $1; $$.comp_alt = $3; }
  124.     |    block else
  125.             { $$.comp_true = $1; $$.comp_alt = $2; }
  126.     ;
  127.  
  128. else    :    /* NULL */
  129.             { $$ = Nullcmd; }
  130.     |    ELSE block
  131.             { $$ = $2; }
  132.     |    ELSIF '(' expr ')' compblock
  133.             { cmdline = $1;
  134.                 $$ = make_ccmd(C_ELSIF,1,$3,$5); }
  135.     ;
  136.  
  137. block    :    '{' remember lineseq '}'
  138.             { $$ = block_head($3);
  139.               if (cmdline > (line_t)$1)
  140.                   cmdline = $1;
  141.               if (savestack->ary_fill > $2)
  142.                 restorelist($2);
  143.               expectterm = 2; }
  144.     ;
  145.  
  146. remember:    /* NULL */    /* in case they push a package name */
  147.             { $$ = savestack->ary_fill; }
  148.     ;
  149.  
  150. lineseq    :    /* NULL */
  151.             { $$ = Nullcmd; }
  152.     |    lineseq line
  153.             { $$ = append_line($1,$2); }
  154.     ;
  155.  
  156. line    :    decl
  157.             { $$ = Nullcmd; }
  158.     |    label cond
  159.             { $$ = add_label($1,$2); }
  160.     |    loop    /* loops add their own labels */
  161.     |    label ';'
  162.             { if ($1 != Nullch) {
  163.                   $$ = add_label($1, make_acmd(C_EXPR, Nullstab,
  164.                   Nullarg, Nullarg) );
  165.                 }
  166.                 else {
  167.                   $$ = Nullcmd;
  168.                   cmdline = NOLINE;
  169.                 }
  170.                 expectterm = 2; }
  171.     |    label sideff ';'
  172.             { $$ = add_label($1,$2);
  173.               expectterm = 2; }
  174.     ;
  175.  
  176. sideff    :    error
  177.             { $$ = Nullcmd; }
  178.     |    expr
  179.             { $$ = make_acmd(C_EXPR, Nullstab, $1, Nullarg); }
  180.     |    expr IF expr
  181.             { $$ = addcond(
  182.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  183.     |    expr UNLESS expr
  184.             { $$ = addcond(invert(
  185.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  186.     |    expr WHILE expr
  187.             { $$ = addloop(
  188.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1), $3); }
  189.     |    expr UNTIL expr
  190.             { $$ = addloop(invert(
  191.                    make_acmd(C_EXPR, Nullstab, Nullarg, $1)), $3); }
  192.     ;
  193.  
  194. cond    :    IF '(' expr ')' compblock
  195.             { cmdline = $1;
  196.                 $$ = make_icmd(C_IF,$3,$5); }
  197.     |    UNLESS '(' expr ')' compblock
  198.             { cmdline = $1;
  199.                 $$ = invert(make_icmd(C_IF,$3,$5)); }
  200.     |    IF block compblock
  201.             { cmdline = $1;
  202.                 $$ = make_icmd(C_IF,cmd_to_arg($2),$3); }
  203.     |    UNLESS block compblock
  204.             { cmdline = $1;
  205.                 $$ = invert(make_icmd(C_IF,cmd_to_arg($2),$3)); }
  206.     ;
  207.  
  208. loop    :    label WHILE '(' texpr ')' compblock
  209.             { cmdline = $2;
  210.                 $$ = wopt(add_label($1,
  211.                 make_ccmd(C_WHILE,1,$4,$6) )); }
  212.     |    label UNTIL '(' expr ')' compblock
  213.             { cmdline = $2;
  214.                 $$ = wopt(add_label($1,
  215.                 invert(make_ccmd(C_WHILE,1,$4,$6)) )); }
  216.     |    label WHILE block compblock
  217.             { cmdline = $2;
  218.                 $$ = wopt(add_label($1,
  219.                 make_ccmd(C_WHILE, 1, cmd_to_arg($3),$4) )); }
  220.     |    label UNTIL block compblock
  221.             { cmdline = $2;
  222.                 $$ = wopt(add_label($1,
  223.                 invert(make_ccmd(C_WHILE,1,cmd_to_arg($3),$4)) )); }
  224.     |    label FOR REG '(' expr crp compblock
  225.             { cmdline = $2;
  226.                 /*
  227.                  * The following gobbledygook catches EXPRs that
  228.                  * aren't explicit array refs and translates
  229.                  *        foreach VAR (EXPR) {
  230.                  * into
  231.                  *        @ary = EXPR;
  232.                  *        foreach VAR (@ary) {
  233.                  * where @ary is a hidden array made by genstab().
  234.                  * (Note that @ary may become a local array if
  235.                  * it is determined that it might be called
  236.                  * recursively.  See cmd_tosave().)
  237.                  */
  238.                 if ($5->arg_type != O_ARRAY) {
  239.                 scrstab = aadd(genstab());
  240.                 $$ = append_line(
  241.                     make_acmd(C_EXPR, Nullstab,
  242.                       l(make_op(O_ASSIGN,2,
  243.                     listish(make_op(O_ARRAY, 1,
  244.                       stab2arg(A_STAB,scrstab),
  245.                       Nullarg,Nullarg )),
  246.                     listish(make_list($5)),
  247.                     Nullarg)),
  248.                       Nullarg),
  249.                     wopt(over($3,add_label($1,
  250.                       make_ccmd(C_WHILE, 0,
  251.                     make_op(O_ARRAY, 1,
  252.                       stab2arg(A_STAB,scrstab),
  253.                       Nullarg,Nullarg ),
  254.                     $7)))));
  255.                 $$->c_line = $2;
  256.                 $$->c_head->c_line = $2;
  257.                 }
  258.                 else {
  259.                 $$ = wopt(over($3,add_label($1,
  260.                 make_ccmd(C_WHILE,1,$5,$7) )));
  261.                 }
  262.             }
  263.     |    label FOR '(' expr crp compblock
  264.             { cmdline = $2;
  265.                 if ($4->arg_type != O_ARRAY) {
  266.                 scrstab = aadd(genstab());
  267.                 $$ = append_line(
  268.                     make_acmd(C_EXPR, Nullstab,
  269.                       l(make_op(O_ASSIGN,2,
  270.                     listish(make_op(O_ARRAY, 1,
  271.                       stab2arg(A_STAB,scrstab),
  272.                       Nullarg,Nullarg )),
  273.                     listish(make_list($4)),
  274.                     Nullarg)),
  275.                       Nullarg),
  276.                     wopt(over(defstab,add_label($1,
  277.                       make_ccmd(C_WHILE, 0,
  278.                     make_op(O_ARRAY, 1,
  279.                       stab2arg(A_STAB,scrstab),
  280.                       Nullarg,Nullarg ),
  281.                     $6)))));
  282.                 $$->c_line = $2;
  283.                 $$->c_head->c_line = $2;
  284.                 }
  285.                 else {    /* lisp, anyone? */
  286.                 $$ = wopt(over(defstab,add_label($1,
  287.                 make_ccmd(C_WHILE,1,$4,$6) )));
  288.                 }
  289.             }
  290.     |    label FOR '(' nexpr ';' texpr ';' nexpr ')' block
  291.             /* basically fake up an initialize-while lineseq */
  292.             {   yyval.compval.comp_true = $10;
  293.                 yyval.compval.comp_alt = $8;
  294.                 cmdline = $2;
  295.                 $$ = append_line($4,wopt(add_label($1,
  296.                 make_ccmd(C_WHILE,1,$6,yyval.compval) ))); }
  297.     |    label compblock    /* a block is a loop that happens once */
  298.             { $$ = add_label($1,make_ccmd(C_BLOCK,1,Nullarg,$2)); }
  299.     ;
  300.  
  301. nexpr    :    /* NULL */
  302.             { $$ = Nullcmd; }
  303.     |    sideff
  304.     ;
  305.  
  306. texpr    :    /* NULL means true */
  307.             { (void)scanstr("1",SCAN_DEF); $$ = yylval.arg; }
  308.     |    expr
  309.     ;
  310.  
  311. label    :    /* empty */
  312.             { $$ = Nullch; }
  313.     |    LABEL
  314.     ;
  315.  
  316. decl    :    format
  317.             { $$ = 0; }
  318.     |    subrout
  319.             { $$ = 0; }
  320.     |    package
  321.             { $$ = 0; }
  322.     ;
  323.  
  324. format    :    FORMAT WORD '=' FORMLIST
  325.             { if (strEQ($2,"stdout"))
  326.                 make_form(stabent("STDOUT",TRUE),$4);
  327.               else if (strEQ($2,"stderr"))
  328.                 make_form(stabent("STDERR",TRUE),$4);
  329.               else
  330.                 make_form(stabent($2,TRUE),$4);
  331.               Safefree($2); $2 = Nullch; }
  332.     |    FORMAT '=' FORMLIST
  333.             { make_form(stabent("STDOUT",TRUE),$3); }
  334.     ;
  335.  
  336. subrout    :    SUB WORD block
  337.             { make_sub($2,$3);
  338.               cmdline = NOLINE;
  339.               if (savestack->ary_fill > $1)
  340.                 restorelist($1); }
  341.     ;
  342.  
  343. package :    PACKAGE WORD ';'
  344.             { char tmpbuf[256];
  345.               STAB *tmpstab;
  346.  
  347.               savehptr(&curstash);
  348.               saveitem(curstname);
  349.               str_set(curstname,$2);
  350.               sprintf(tmpbuf,"'_%s",$2);
  351.               tmpstab = stabent(tmpbuf,TRUE);
  352.               if (!stab_xhash(tmpstab))
  353.                   stab_xhash(tmpstab) = hnew(0);
  354.               curstash = stab_xhash(tmpstab);
  355.               if (!curstash->tbl_name)
  356.                   curstash->tbl_name = savestr($2);
  357.               curstash->tbl_coeffsize = 0;
  358.               Safefree($2); $2 = Nullch;
  359.               cmdline = NOLINE;
  360.               expectterm = 2;
  361.             }
  362.     ;
  363.  
  364. cexpr    :    ',' expr
  365.             { $$ = $2; }
  366.     ;
  367.  
  368. expr    :    expr ',' sexpr
  369.             { $$ = make_op(O_COMMA, 2, $1, $3, Nullarg); }
  370.     |    sexpr
  371.     ;
  372.  
  373. csexpr    :    ',' sexpr
  374.             { $$ = $2; }
  375.     ;
  376.  
  377. sexpr    :    sexpr '=' sexpr
  378.             {   $1 = listish($1);
  379.                 if ($1->arg_type == O_ASSIGN && $1->arg_len == 1)
  380.                 $1->arg_type = O_ITEM;    /* a local() */
  381.                 if ($1->arg_type == O_LIST)
  382.                 $3 = listish($3);
  383.                 $$ = l(make_op(O_ASSIGN, 2, $1, $3, Nullarg)); }
  384.     |    sexpr POW '=' sexpr
  385.             { $$ = l(make_op(O_POW, 2, $1, $4, Nullarg)); }
  386.     |    sexpr MULOP '=' sexpr
  387.             { $$ = l(make_op($2, 2, $1, $4, Nullarg)); }
  388.     |    sexpr ADDOP '=' sexpr
  389.             { $$ = rcatmaybe(l(make_op($2, 2, $1, $4, Nullarg)));}
  390.     |    sexpr LS '=' sexpr
  391.             { $$ = l(make_op(O_LEFT_SHIFT, 2, $1, $4, Nullarg)); }
  392.     |    sexpr RS '=' sexpr
  393.             { $$ = l(make_op(O_RIGHT_SHIFT, 2, $1, $4, Nullarg)); }
  394.     |    sexpr '&' '=' sexpr
  395.             { $$ = l(make_op(O_BIT_AND, 2, $1, $4, Nullarg)); }
  396.     |    sexpr '^' '=' sexpr
  397.             { $$ = l(make_op(O_XOR, 2, $1, $4, Nullarg)); }
  398.     |    sexpr '|' '=' sexpr
  399.             { $$ = l(make_op(O_BIT_OR, 2, $1, $4, Nullarg)); }
  400.  
  401.  
  402.     |    sexpr POW sexpr
  403.             { $$ = make_op(O_POW, 2, $1, $3, Nullarg); }
  404.     |    sexpr MULOP sexpr
  405.             { if ($2 == O_REPEAT)
  406.                   $1 = listish($1);
  407.                 $$ = make_op($2, 2, $1, $3, Nullarg);
  408.                 if ($2 == O_REPEAT) {
  409.                 if ($$[1].arg_type != A_EXPR ||
  410.                   $$[1].arg_ptr.arg_arg->arg_type != O_LIST)
  411.                     $$[1].arg_flags &= ~AF_ARYOK;
  412.                 } }
  413.     |    sexpr ADDOP sexpr
  414.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  415.     |    sexpr LS sexpr
  416.             { $$ = make_op(O_LEFT_SHIFT, 2, $1, $3, Nullarg); }
  417.     |    sexpr RS sexpr
  418.             { $$ = make_op(O_RIGHT_SHIFT, 2, $1, $3, Nullarg); }
  419.     |    sexpr RELOP sexpr
  420.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  421.     |    sexpr EQOP sexpr
  422.             { $$ = make_op($2, 2, $1, $3, Nullarg); }
  423.     |    sexpr '&' sexpr
  424.             { $$ = make_op(O_BIT_AND, 2, $1, $3, Nullarg); }
  425.     |    sexpr '^' sexpr
  426.             { $$ = make_op(O_XOR, 2, $1, $3, Nullarg); }
  427.     |    sexpr '|' sexpr
  428.             { $$ = make_op(O_BIT_OR, 2, $1, $3, Nullarg); }
  429.     |    sexpr DOTDOT sexpr
  430.             { arg4 = Nullarg;
  431.               $$ = make_op(O_F_OR_R, 4, $1, $3, Nullarg);
  432.               $$[0].arg_flags |= $2; }
  433.     |    sexpr ANDAND sexpr
  434.             { $$ = make_op(O_AND, 2, $1, $3, Nullarg); }
  435.     |    sexpr OROR sexpr
  436.             { $$ = make_op(O_OR, 2, $1, $3, Nullarg); }
  437.     |    sexpr '?' sexpr ':' sexpr
  438.             { $$ = make_op(O_COND_EXPR, 3, $1, $3, $5); }
  439.     |    sexpr MATCH sexpr
  440.             { $$ = mod_match(O_MATCH, $1, $3); }
  441.     |    sexpr NMATCH sexpr
  442.             { $$ = mod_match(O_NMATCH, $1, $3); }
  443.     |    term
  444.             { $$ = $1; }
  445.     ;
  446.  
  447. term    :    '-' term %prec UMINUS
  448.             { $$ = make_op(O_NEGATE, 1, $2, Nullarg, Nullarg); }
  449.     |    '+' term %prec UMINUS
  450.             { $$ = $2; }
  451.     |    '!' term
  452.             { $$ = make_op(O_NOT, 1, $2, Nullarg, Nullarg); }
  453.     |    '~' term
  454.             { $$ = make_op(O_COMPLEMENT, 1, $2, Nullarg, Nullarg);}
  455.     |    term INC
  456.             { $$ = addflags(1, AF_POST|AF_UP,
  457.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  458.     |    term DEC
  459.             { $$ = addflags(1, AF_POST,
  460.                 l(make_op(O_ITEM,1,$1,Nullarg,Nullarg))); }
  461.     |    INC term
  462.             { $$ = addflags(1, AF_PRE|AF_UP,
  463.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  464.     |    DEC term
  465.             { $$ = addflags(1, AF_PRE,
  466.                 l(make_op(O_ITEM,1,$2,Nullarg,Nullarg))); }
  467.     |    FILETEST WORD
  468.             { opargs[$1] = 0;    /* force it special */
  469.                 $$ = make_op($1, 1,
  470.                 stab2arg(A_STAB,stabent($2,TRUE)),
  471.                 Nullarg, Nullarg);
  472.                 Safefree($2); $2 = Nullch;
  473.             }
  474.     |    FILETEST sexpr
  475.             { opargs[$1] = 1;
  476.                 $$ = make_op($1, 1, $2, Nullarg, Nullarg); }
  477.     |    FILETEST
  478.             { opargs[$1] = ($1 != O_FTTTY);
  479.                 $$ = make_op($1, 1,
  480.                 stab2arg(A_STAB,
  481.                   $1 == O_FTTTY?stabent("STDIN",TRUE):defstab),
  482.                 Nullarg, Nullarg); }
  483.     |    LOCAL '(' expr crp
  484.             { $$ = l(localize(make_op(O_ASSIGN, 1,
  485.                 localize(listish(make_list($3))),
  486.                 Nullarg,Nullarg))); }
  487.     |    '(' expr crp
  488.             { $$ = make_list($2); }
  489.     |    '(' ')'
  490.             { $$ = make_list(Nullarg); }
  491.     |    DO sexpr    %prec FILETEST
  492.             { $$ = make_op(O_DOFILE,2,$2,Nullarg,Nullarg);
  493.               allstabs = TRUE;}
  494.     |    DO block    %prec '('
  495.             { $$ = cmd_to_arg($2); }
  496.     |    REG    %prec '('
  497.             { $$ = stab2arg(A_STAB,$1); }
  498.     |    STAR    %prec '('
  499.             { $$ = stab2arg(A_STAR,$1); }
  500.     |    REG '[' expr ']'    %prec '('
  501.             { $$ = make_op(O_AELEM, 2,
  502.                 stab2arg(A_STAB,aadd($1)), $3, Nullarg); }
  503.     |    HSH     %prec '('
  504.             { $$ = make_op(O_HASH, 1,
  505.                 stab2arg(A_STAB,$1),
  506.                 Nullarg, Nullarg); }
  507.     |    ARY     %prec '('
  508.             { $$ = make_op(O_ARRAY, 1,
  509.                 stab2arg(A_STAB,$1),
  510.                 Nullarg, Nullarg); }
  511.     |    REG '{' expr ';' '}'    %prec '('
  512.             { $$ = make_op(O_HELEM, 2,
  513.                 stab2arg(A_STAB,hadd($1)),
  514.                 jmaybe($3),
  515.                 Nullarg);
  516.                 expectterm = FALSE; }
  517.     |    '(' expr crp '[' expr ']'    %prec '('
  518.             { $$ = make_op(O_LSLICE, 3,
  519.                 Nullarg,
  520.                 listish(make_list($5)),
  521.                 listish(make_list($2))); }
  522.     |    '(' ')' '[' expr ']'    %prec '('
  523.             { $$ = make_op(O_LSLICE, 3,
  524.                 Nullarg,
  525.                 listish(make_list($4)),
  526.                 Nullarg); }
  527.     |    ARY '[' expr ']'    %prec '('
  528.             { $$ = make_op(O_ASLICE, 2,
  529.                 stab2arg(A_STAB,aadd($1)),
  530.                 listish(make_list($3)),
  531.                 Nullarg); }
  532.     |    ARY '{' expr ';' '}'    %prec '('
  533.             { $$ = make_op(O_HSLICE, 2,
  534.                 stab2arg(A_STAB,hadd($1)),
  535.                 listish(make_list($3)),
  536.                 Nullarg);
  537.                 expectterm = FALSE; }
  538.     |    DELETE REG '{' expr ';' '}'    %prec '('
  539.             { $$ = make_op(O_DELETE, 2,
  540.                 stab2arg(A_STAB,hadd($2)),
  541.                 jmaybe($4),
  542.                 Nullarg);
  543.                 expectterm = FALSE; }
  544.     |    DELETE '(' REG '{' expr ';' '}' ')'    %prec '('
  545.             { $$ = make_op(O_DELETE, 2,
  546.                 stab2arg(A_STAB,hadd($3)),
  547.                 jmaybe($5),
  548.                 Nullarg);
  549.                 expectterm = FALSE; }
  550.     |    ARYLEN    %prec '('
  551.             { $$ = stab2arg(A_ARYLEN,$1); }
  552.     |    RSTRING    %prec '('
  553.             { $$ = $1; }
  554.     |    PATTERN    %prec '('
  555.             { $$ = $1; }
  556.     |    SUBST    %prec '('
  557.             { $$ = $1; }
  558.     |    TRANS    %prec '('
  559.             { $$ = $1; }
  560.     |    DO WORD '(' expr crp
  561.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  562.                 stab2arg(A_WORD,stabent($2,MULTI)),
  563.                 make_list($4),
  564.                 Nullarg); Safefree($2); $2 = Nullch;
  565.                 $$->arg_flags |= AF_DEPR; }
  566.     |    AMPER WORD '(' expr crp
  567.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  568.                 stab2arg(A_WORD,stabent($2,MULTI)),
  569.                 make_list($4),
  570.                 Nullarg); Safefree($2); $2 = Nullch; }
  571.     |    DO WORD '(' ')'
  572.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  573.                 stab2arg(A_WORD,stabent($2,MULTI)),
  574.                 make_list(Nullarg),
  575.                 Nullarg);
  576.                 Safefree($2); $2 = Nullch;
  577.                 $$->arg_flags |= AF_DEPR; }
  578.     |    AMPER WORD '(' ')'
  579.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  580.                 stab2arg(A_WORD,stabent($2,MULTI)),
  581.                 make_list(Nullarg),
  582.                 Nullarg);
  583.                 Safefree($2); $2 = Nullch;
  584.             }
  585.     |    AMPER WORD
  586.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  587.                 stab2arg(A_WORD,stabent($2,MULTI)),
  588.                 Nullarg,
  589.                 Nullarg);
  590.                 Safefree($2); $2 = Nullch;
  591.             }
  592.     |    DO REG '(' expr crp
  593.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  594.                 stab2arg(A_STAB,$2),
  595.                 make_list($4),
  596.                 Nullarg);
  597.                 $$->arg_flags |= AF_DEPR; }
  598.     |    AMPER REG '(' expr crp
  599.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  600.                 stab2arg(A_STAB,$2),
  601.                 make_list($4),
  602.                 Nullarg); }
  603.     |    DO REG '(' ')'
  604.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  605.                 stab2arg(A_STAB,$2),
  606.                 make_list(Nullarg),
  607.                 Nullarg);
  608.                 $$->arg_flags |= AF_DEPR; }
  609.     |    AMPER REG '(' ')'
  610.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  611.                 stab2arg(A_STAB,$2),
  612.                 make_list(Nullarg),
  613.                 Nullarg); }
  614.     |    AMPER REG
  615.             { $$ = make_op((perldb ? O_DBSUBR : O_SUBR), 2,
  616.                 stab2arg(A_STAB,$2),
  617.                 Nullarg,
  618.                 Nullarg); }
  619.     |    LOOPEX
  620.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  621.     |    LOOPEX WORD
  622.             { $$ = make_op($1,1,cval_to_arg($2),
  623.                 Nullarg,Nullarg); }
  624.     |    UNIOP
  625.             { $$ = make_op($1,0,Nullarg,Nullarg,Nullarg); }
  626.     |    UNIOP block
  627.             { $$ = make_op($1,1,cmd_to_arg($2),Nullarg,Nullarg); }
  628.     |    UNIOP sexpr
  629.             { $$ = make_op($1,1,$2,Nullarg,Nullarg); }
  630.     |    SSELECT
  631.             { $$ = make_op(O_SELECT, 0, Nullarg, Nullarg, Nullarg);}
  632.     |    SSELECT  WORD
  633.             { $$ = make_op(O_SELECT, 1,
  634.                 stab2arg(A_WORD,stabent($2,TRUE)),
  635.                 Nullarg,
  636.                 Nullarg);
  637.                 Safefree($2); $2 = Nullch; }
  638.     |    SSELECT '(' handle ')'
  639.             { $$ = make_op(O_SELECT, 1, $3, Nullarg, Nullarg); }
  640.     |    SSELECT '(' sexpr csexpr csexpr csexpr ')'
  641.             { arg4 = $6;
  642.               $$ = make_op(O_SSELECT, 4, $3, $4, $5); }
  643.     |    OPEN WORD    %prec '('
  644.             { $$ = make_op(O_OPEN, 2,
  645.                 stab2arg(A_WORD,stabent($2,TRUE)),
  646.                 stab2arg(A_STAB,stabent($2,TRUE)),
  647.                 Nullarg);
  648.                 Safefree($2); $2 = Nullch;
  649.             }
  650.     |    OPEN '(' WORD ')'
  651.             { $$ = make_op(O_OPEN, 2,
  652.                 stab2arg(A_WORD,stabent($3,TRUE)),
  653.                 stab2arg(A_STAB,stabent($3,TRUE)),
  654.                 Nullarg);
  655.                 Safefree($3); $3 = Nullch;
  656.             }
  657.     |    OPEN '(' handle cexpr ')'
  658.             { $$ = make_op(O_OPEN, 2,
  659.                 $3,
  660.                 $4, Nullarg); }
  661.     |    FILOP '(' handle ')'
  662.             { $$ = make_op($1, 1,
  663.                 $3,
  664.                 Nullarg, Nullarg); }
  665.     |    FILOP WORD
  666.             { $$ = make_op($1, 1,
  667.                 stab2arg(A_WORD,stabent($2,TRUE)),
  668.                 Nullarg, Nullarg);
  669.               Safefree($2); $2 = Nullch; }
  670.     |    FILOP REG
  671.             { $$ = make_op($1, 1,
  672.                 stab2arg(A_STAB,$2),
  673.                 Nullarg, Nullarg); }
  674.     |    FILOP '(' ')'
  675.             { $$ = make_op($1, 1,
  676.                 stab2arg(A_WORD,Nullstab),
  677.                 Nullarg, Nullarg); }
  678.     |    FILOP    %prec '('
  679.             { $$ = make_op($1, 0,
  680.                 Nullarg, Nullarg, Nullarg); }
  681.     |    FILOP2 '(' handle cexpr ')'
  682.             { $$ = make_op($1, 2, $3, $4, Nullarg); }
  683.     |    FILOP3 '(' handle csexpr cexpr ')'
  684.             { $$ = make_op($1, 3, $3, $4, make_list($5)); }
  685.     |    FILOP22 '(' handle ',' handle ')'
  686.             { $$ = make_op($1, 2, $3, $5, Nullarg); }
  687.     |    FILOP4 '(' handle csexpr csexpr cexpr ')'
  688.             { arg4 = $6; $$ = make_op($1, 4, $3, $4, $5); }
  689.     |    FILOP25 '(' handle ',' handle csexpr csexpr cexpr ')'
  690.             { arg4 = $7; arg5 = $8;
  691.               $$ = make_op($1, 5, $3, $5, $6); }
  692.     |    PUSH '(' aryword ',' expr crp
  693.             { $$ = make_op($1, 2,
  694.                 $3,
  695.                 make_list($5),
  696.                 Nullarg); }
  697.     |    POP aryword    %prec '('
  698.             { $$ = make_op(O_POP, 1, $2, Nullarg, Nullarg); }
  699.     |    POP '(' aryword ')'
  700.             { $$ = make_op(O_POP, 1, $3, Nullarg, Nullarg); }
  701.     |    SHIFT aryword    %prec '('
  702.             { $$ = make_op(O_SHIFT, 1, $2, Nullarg, Nullarg); }
  703.     |    SHIFT '(' aryword ')'
  704.             { $$ = make_op(O_SHIFT, 1, $3, Nullarg, Nullarg); }
  705.     |    SHIFT    %prec '('
  706.             { $$ = make_op(O_SHIFT, 1,
  707.                 stab2arg(A_STAB,
  708.                   aadd(stabent(subline ? "_" : "ARGV", TRUE))),
  709.                 Nullarg, Nullarg); }
  710.     |    SPLIT    %prec '('
  711.             {   static char p[]="/\\s+/";
  712.                 char *oldend = bufend;
  713.                 ARG *oldarg = yylval.arg;
  714.                 
  715.                 bufend=p+5;
  716.                 (void)scanpat(p);
  717.                 bufend=oldend;
  718.                 $$ = make_split(defstab,yylval.arg,Nullarg);
  719.                 yylval.arg = oldarg; }
  720.     |    SPLIT '(' sexpr csexpr csexpr ')'
  721.             { $$ = mod_match(O_MATCH, $4,
  722.               make_split(defstab,$3,$5));}
  723.     |    SPLIT '(' sexpr csexpr ')'
  724.             { $$ = mod_match(O_MATCH, $4,
  725.               make_split(defstab,$3,Nullarg) ); }
  726.     |    SPLIT '(' sexpr ')'
  727.             { $$ = mod_match(O_MATCH,
  728.                 stab2arg(A_STAB,defstab),
  729.                 make_split(defstab,$3,Nullarg) ); }
  730.     |    FLIST2 '(' sexpr cexpr ')'
  731.             { $$ = make_op($1, 2,
  732.                 $3,
  733.                 listish(make_list($4)),
  734.                 Nullarg); }
  735.     |    FLIST '(' expr crp
  736.             { $$ = make_op($1, 1,
  737.                 make_list($3),
  738.                 Nullarg,
  739.                 Nullarg); }
  740.     |    FMIN1 '(' sexpr ')'
  741.             { $$ = make_op($1, 2,
  742.                 $3,
  743.                 Nullarg,
  744.                 Nullarg); }
  745.     |    FMIN1 '(' sexpr cexpr ')'
  746.             { $$ = make_op($1, 2,
  747.                 $3,
  748.                 listish(make_list($4)),
  749.                 Nullarg); }
  750.     |    LVALFUN sexpr    %prec '('
  751.             { $$ = l(make_op($1, 1, fixl($1,$2),
  752.                 Nullarg, Nullarg)); }
  753.     |    LVALFUN
  754.             { $$ = l(make_op($1, 1,
  755.                 stab2arg(A_STAB,defstab),
  756.                 Nullarg, Nullarg)); }
  757.     |    FUNC0
  758.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  759.     |    FUNC0 '(' ')'
  760.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  761.     |    FUNC1 '(' ')'
  762.             { $$ = make_op($1, 0, Nullarg, Nullarg, Nullarg); }
  763.     |    FUNC1 '(' expr ')'
  764.             { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
  765.     |    FUNC2 '(' sexpr cexpr ')'
  766.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  767.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  768.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  769.     |    FUNC2x '(' sexpr csexpr ')'
  770.             { $$ = make_op($1, 2, $3, $4, Nullarg);
  771.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  772.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  773.     |    FUNC2x '(' sexpr csexpr cexpr ')'
  774.             { $$ = make_op($1, 3, $3, $4, $5);
  775.                 if ($1 == O_INDEX && $$[2].arg_type == A_SINGLE)
  776.                 fbmcompile($$[2].arg_ptr.arg_str,0); }
  777.     |    FUNC12 '(' sexpr ')'
  778.             { $$ = make_op($1, 1, $3, Nullarg, Nullarg); }
  779.     |    FUNC12 '(' sexpr cexpr ')'
  780.             { $$ = make_op($1, 2, $3, $4, Nullarg); }
  781.     |    FUNC3 '(' sexpr csexpr cexpr ')'
  782.             { $$ = make_op($1, 3, $3, $4, $5); }
  783.     |    FUNC4 '(' sexpr csexpr csexpr cexpr ')'
  784.             { arg4 = $6;
  785.               $$ = make_op($1, 4, $3, $4, $5); }
  786.     |    FUNC5 '(' sexpr csexpr csexpr csexpr cexpr ')'
  787.             { arg4 = $6; arg5 = $7;
  788.               $$ = make_op($1, 5, $3, $4, $5); }
  789.     |    CHOOSE '(' sexpr csexpr csexpr ')'
  790.             { $$ = make_op($1, 3, $3, $4, $5); }
  791.     |    CHOOSE '(' sexpr csexpr csexpr csexpr ')'
  792.             { arg4 = $6; 
  793.               $$ = make_op($1, 4, $3, $4, $5); }
  794.     |    CHOOSE '(' sexpr csexpr csexpr csexpr csexpr ')'
  795.             { arg4 = $6; arg5 = $7;
  796.               $$ = make_op($1, 5, $3, $4, $5); }
  797.     |    CHOOSE '(' sexpr csexpr csexpr csexpr csexpr csexpr ')'
  798.             { arg4 = $6; arg5 = $7; arg6 = $8;
  799.               $$ = make_op($1, 6, $3, $4, $5); }
  800.     |    HSHFUN '(' hshword ')'
  801.             { $$ = make_op($1, 1,
  802.                 $3,
  803.                 Nullarg,
  804.                 Nullarg); }
  805.     |    HSHFUN hshword
  806.             { $$ = make_op($1, 1,
  807.                 $2,
  808.                 Nullarg,
  809.                 Nullarg); }
  810.     |    HSHFUN3 '(' hshword csexpr cexpr ')'
  811.             { $$ = make_op($1, 3, $3, $4, $5); }
  812.     |    bareword
  813.     |    listop
  814.     ;
  815.  
  816. listop    :    LISTOP
  817.             { $$ = make_op($1,2,
  818.                 stab2arg(A_WORD,Nullstab),
  819.                 stab2arg(A_STAB,defstab),
  820.                 Nullarg); }
  821.     |    LISTOP expr
  822.             { $$ = make_op($1,2,
  823.                 stab2arg(A_WORD,Nullstab),
  824.                 maybelistish($1,make_list($2)),
  825.                 Nullarg); }
  826.     |    LISTOP WORD
  827.             { $$ = make_op($1,2,
  828.                 stab2arg(A_WORD,stabent($2,TRUE)),
  829.                 stab2arg(A_STAB,defstab),
  830.                 Nullarg);
  831.                 Safefree($2); $2 = Nullch;
  832.             }
  833.     |    LISTOP WORD expr
  834.             { $$ = make_op($1,2,
  835.                 stab2arg(A_WORD,stabent($2,TRUE)),
  836.                 maybelistish($1,make_list($3)),
  837.                 Nullarg); Safefree($2); $2 = Nullch; }
  838.     |    LISTOP REG expr
  839.             { $$ = make_op($1,2,
  840.                 stab2arg(A_STAB,$2),
  841.                 maybelistish($1,make_list($3)),
  842.                 Nullarg); }
  843.     |    LISTOP block expr
  844.             { $$ = make_op($1,2,
  845.                 cmd_to_arg($2),
  846.                 maybelistish($1,make_list($3)),
  847.                 Nullarg); }
  848.     ;
  849.  
  850. handle    :    WORD
  851.             { $$ = stab2arg(A_WORD,stabent($1,TRUE));
  852.               Safefree($1); $1 = Nullch;}
  853.     |    sexpr
  854.     ;
  855.  
  856. aryword    :    WORD
  857.             { $$ = stab2arg(A_WORD,aadd(stabent($1,TRUE)));
  858.                 Safefree($1); $1 = Nullch; }
  859.     |    ARY
  860.             { $$ = stab2arg(A_STAB,$1); }
  861.     ;
  862.  
  863. hshword    :    WORD
  864.             { $$ = stab2arg(A_WORD,hadd(stabent($1,TRUE)));
  865.                 Safefree($1); $1 = Nullch; }
  866.     |    HSH
  867.             { $$ = stab2arg(A_STAB,$1); }
  868.     ;
  869.  
  870. crp    :    ',' ')'
  871.             { $$ = 1; }
  872.     |    ')'
  873.             { $$ = 0; }
  874.     ;
  875.  
  876. /*
  877.  * NOTE:  The following entry must stay at the end of the file so that
  878.  * reduce/reduce conflicts resolve to it only if it's the only option.
  879.  */
  880.  
  881. bareword:    WORD
  882.             { char *s;
  883.                 $$ = op_new(1);
  884.                 $$->arg_type = O_ITEM;
  885.                 $$[1].arg_type = A_SINGLE;
  886.                 $$[1].arg_ptr.arg_str = str_make($1,0);
  887.                 for (s = $1; *s && isLOWER(*s); s++) ;
  888.                 if (dowarn && !*s)
  889.                 warn(
  890.                   "\"%s\" may clash with future reserved word",
  891.                   $1 );
  892.                 Safefree($1); $1 = Nullch;
  893.             }
  894.         ;
  895. %% /* PROGRAM */
  896.